perm filename RHQUIK.F4[NEW,LCS] blob sn#493280 filedate 1980-01-27 generic text, type T, neo UTF8
00100		SUBROUTINE RHQUIK
00200	C TRANSLATES Z=W, X=H, C=Q, V=E, B=S
00300		COMMON /ALF/INP(72)
00310		DO 5 LEND=72,1,-1
00320	5	IF(INP(LEND).NE.' ')GO TO 6
00325	C**** BUT WHAT ABOUT MOTIVES????????
00330	6	DO 7 K=1,LEND
00340		N=INP(K)
00350	7	IF(N.EQ.'Z'.OR.N.EQ.'C'.OR.N.EQ.'V'.OR.N.EQ.'B')GO TO 8
00355	C GOES BACK IF NO SPECIAL RHYTHM CHARACTERS FOUND. (ASSUMES NO LONE X)
00360		RETURN
00400	8	DO 1 K=1,LEND
00500		N=INP(K)
00550		IF(N.EQ.' ')GO TO 1
00600		IF(N.EQ.'Z')INP(K)='W'
00700		IF(N.EQ.'C')INP(K)='Q'
00800		IF(N.EQ.'V')INP(K)='E'
00900		IF(N.EQ.'B')INP(K)='S'
01000		IF(N.NE.'X')GO TO 1
01010	C SO X ISN'T CONFUSED WITH /QX16/ ETC.
01050		IF(K.EQ.1)GO TO 3
01100		DO 2 J=K-1,1,-1
01200		L=INP(J)
01300		IF(L.EQ.' ')GO TO 2
01400		IF(L.NE.'/')GO TO 1
01410	3	INP(K)='H'
01420		GO TO 1
01500	2	CONTINUE
01600	1	CONTINUE
01610		TYPE 4,(INP(K),K=1,LEND)
01620	4	FORMAT(1X72A1)
01630		END